Internet Info 1993/Internet Info CD-ROM (Walnut Creek) (1993).iso/networking/terms/kermit/d/h800ker.pas

Pascal/Delphi Source File | 1988-08-16 | 68.1 KB | 2,642 lines

  PROGRAM Kermit(input,output,file3,file4,file5,
                file6,file7,file8,file9,filen,filet);

LABEL
  9999;             { used only to simulate a "halt" instruction }


CONST


  bufsize=128;
  lf=12B;
  return=15B;
  formfeed=14B;
  controlbar=28;
  CTRLC=3;
  mask= 177B;

  { standard file descriptors. subscripts in open, etc. }
  STDIN = 1;              { these are not to be changed }
  STDOUT = 2;
  lineout = 3;
  linein = 4;

  { other io-related stuff }
  IOERROR = 0;    { status values for open files }
  IOAVAIL = 1;
  IOREAD = 2;
  IOWRITE = 3;
  MAXOPEN = 9;   { maximum number of open files }

  { universal manifest constants }
  ENDFILE = -1;
  ENDSTR = 0;     { null-terminated strings }
  MAXSTR = 100;   { longest possible string }
  CONLENGTH = 20; { length of constant string }
  FILENAMELENGTH = 17;  { length of file name for Bind }
  MAXERRORS = 50;  { maximum number of errors kept if remote }

  { ascii character set in decimal }
  BACKSPACE = 8;
  TAB = 9;
  NEWLINE = 10;
  BLANK = 32;
  EXCLAM = 33;    { ! }
  DQUOTE = 34;    { " }
  SHARP = 35;     { # }
  DOLLAR = 36;    { $ }
  PERCENT = 37;   { % }
  AMPER = 38;     { & }
  SQUOTE = 39;    { ' }
  ACUTE = SQUOTE;
  LPAREN = 40;    { ( }
  RPAREN = 41;    { ) }
  STAR = 42;      { * }
  PLUS = 43;      { + }
  COMMA = 44;     { , }
  MINUS = 45;     { - }
  DASH = MINUS;
  PERIOD = 46;    { . }
  SLASH = 47;     { / }
  COLON = 58;     { : }
  SEMICOL = 59;   { ; }
  LESS = 60;      { < }
  EQUALS = 61;    { = }
  GREATER = 62;   { > }
  QUESTION = 63;  { ? }
  ATSIGN = 64;    { @ }
  LBRACK = 91;    { [ }
  BACKSLASH = 92; { \ }
  ESCAPE = BACKSLASH; {  changed  - used to be @ }
  RBRACK = 93;    { ] }
  CARET = 94;     { ^ }
  UNDERLINE = 95; { _ }
  GRAVE = 96;     { ` }
  LETA = 97;      { lower case ... }
  LETB = 98;
  LETC = 99;
  LETD = 100;
  LETE = 101;
  LETF = 102;
  LETG = 103;
  LETH = 104;
  LETI = 105;
  LETJ = 106;
  LETK = 107;
  LETL = 108;
  LETM = 109;
  LETN = 110;
  LETO = 111;
  LETP = 112;
  LETQ = 113;
  LETR = 114;
  LETS = 115;
  LETT = 116;
  LETU = 117;
  LETV = 118;
  LETW = 119;
  LETX = 120;
  LETY = 121;
  LETZ = 122;
  LBRACE = 123;   { left brace }
  BAR = 124;      { | }
  RBRACE = 125;   { right brace }
  TILDE = 126;    { ~ }


  SOH          = 1;       (* ascii SOH character *)
  CR           = 13;      (* CR *)
  DEL          = 127;     (* rubout *)

  DEFTRY       = 10;      (* default for number of retries *)
  DEFTIMEOUT   = 12;      (* default time out *)
  MAXPACK      = 94;      (* max is 94 ~ - ' ' *)
  DEFDELAY     = 5;       (* delay before sending first init *)
  NUMPARAM     = 6;       (* number of parameters in init packet *)
  DEFQUOTE     = SHARP;   (* default quote character  *)
  DEFPAD       = 0;       (* default number OF padding chars  *)
  DEFPADCHAR   = 0;       (* default padding character  *)
  DEFDUPLEX    = false;   (* default duplex is full duplex *)
  (* SYSTEM DEPENDENT *)

  DEFEOL  = CR;
  DEFEOLTYPE    = 2;

  (* 1 = LineFeed
   2 = CrLf
   3 = Just Cr *)

  FLEN1 = 8;
  FLEN2 = 8;
  PFILE     = 'KERMIT.P            ';
  TRACEFILE = 'KERMIT.T         ';
  TEMPFILE  = 'TEMP.K              ';
  lp = 'LP:                 ';


  NUMBUFFERS = 5;         (* Number of buffers *)

  (* packet types *)

  TYPEB  = 66; (* ord('B') *)
  TYPED  = 68; (* ord('D') *)
  TYPEE  = 69; (* ord('E') *)
  TYPEF  = 70; (* ord('F') *)
  TYPEN  = 78; (* ord('N') *)
  TYPES  = 83; (* ord('S') *)
  TYPET  = 84; (* ord('T') *)
  TYPEY  = 89; (* ord('Y') *)
  TYPEZ  = 90; (* ord('Z') *)

  MAXCMD = 10;

TYPE

  character = -128..127;  { byte-sized. ascii + other stuff }
  string = ARRAY [1..MAXSTR] OF character;
  mstring = PACKED ARRAY [1..FILENAMELENGTH] OF char;
  vstring = RECORD
              len : integer;
              ch  : ARRAY [1..MAXSTR] OF char;
            END;
  cstring = PACKED ARRAY [1..CONLENGTH] OF char;
  filedesc = IOERROR..MAXOPEN;


  (* Data Types for Kermit *)


  Packet = RECORD
             mark : character;       (* SOH character *)
             count: character;       (* # of bytes following this field *)
             seq  : character;       (* sequence number modulo 64  *)
             ptype: character;       (* d,y,n,s,b,f,z,e,t  packet type *)
             data : string;          (* the actual data *)
             (* chksum is last validchar in data array *)
             (* eol is added, not considered part of packet proper *)
           END;

  Command = (Transmit,Receive,Print,SetParm,Invalid);

  KermitStates = (FileData,Init,Break,FileHeader,EOFile,Complete,Abort);

  EOLtype = (LineFeed,CrLf,JustCr);

  Words = (Low,High);
  Stats = ARRAY [Low..High] OF integer;

  Ppack = 1..NUMBUFFERS;

  CType = RECORD
            check: integer;
            PacketPtr : integer;
            i : integer;
            fld : integer;
            t : character;
            finished : boolean;
            restart : boolean;
            control : boolean;
            good : boolean;
          END;

  InType = (abortnow,nothing,CRin);

VAR

  ch         : char;
  done       : boolean;
  HalfDuplex : boolean;
  BindStatus : integer;

  file3    : text;      { output to other computer }
  file4    : text;      { input from other computer }
  file5    : text;      { assigned to a file to send or receive }
  file6    : text;
  file7    : text;
  file8    : text;
  file9    : text;
  filen    : text;      { check for a file's existance }
  filet    : text;      { trace output }
  filemode : ARRAY [1..MAXOPEN] OF IOERROR..IOWRITE;

  cmdargs  : 0..MAXCMD;
  cmdlin   : string;
  cmdidx   : ARRAY [1..MAXCMD] OF 1..MAXSTR;



  (* Variables for Kermit *)

  aline    : string;
  DiskFile : filedesc;
  SaveState : kermitstates;
  NextArg  : integer;   (* next argument to process *)
  Local    : boolean;   (* local/remote flag *)
  MaxTry   : integer;
  n,J      : integer;   (* packet number *)
  NumTry   : integer;   (* times this packet retried *)
  OldTry   : integer;
  Pad      : integer;    (* padding to send *)
  MyPad    : integer;    (* number of padding characters I need *)
  PadChar  : character;
  MyPadChar: character;
  RunType  : command;
  State    : kermitstates; (* current state of the automaton *)
  MyTimeOut:  integer;     (* when i want to be timed out *)
  TheirTimeOut  : integer;
  Delay    : integer;
  SizeRecv, SizeSend : integer;
  SendEOL, SendQuote : character;
  myEOL,myQuote: character;
  EOLforFile : EOLtype;
  ParmFile : string;
  NumSendPacks : integer;
  NumRecvPacks : integer;
  NumACK : integer;
  NumNAK : integer;
  NumACKrecv : integer;
  NumNAKrecv : integer;
  NumBADrecv : integer;
  RunTime: integer;
  ChInFile, ChInPack : Stats;
  Verbosity: boolean;     (* true to print verbose messages *)
  Trace: boolean;         (* true to write trace info in KERMIT.T file *)
  OneWayOnly : boolean;   (* used for testing *)
  Debug : boolean;
  TtyMode : (Cooked,Raw);
  KeptErrors : ARRAY [1..MAXERRORS] OF cstring;  (* keep errors if remote *)
  NumKeptErrors : integer;

  Buf : ARRAY [1..NUMBUFFERS] OF packet;
  ThisPacket : Ppack; (* current packet being sent *)
  LastPacket : Ppack; (* last packet sent *)
  CurrentPacket : Ppack; (* current packet received *)
  NextPacket : Ppack; (* next packet being received *)
  InputPacket : Ppack; (* save input to do debug *)

  TOPacket : packet; (* Time_Out Packet *)
  TimeLeft : integer; (* until Time_Out *)

  FromConsole : InType;   (* Input from Console during receive *)

  PackControl : CType;  (* variables for receive packet routine *)

  { prims -- primitive functions and procedures   }

PROCEDURE SYSINIT; ALIEN;
  { System dependent initialize }

FUNCTION CONNECT(DUPLEX : BOOLEAN): BOOLEAN; ALIEN;
  { Connect to remote host computer--we are local.
    Echange characters between host and terminal until
    user presses escape code.  DUPLEX is false for full
    duplex, true for half duplex.  Return false if this
    Kermit is host only (no connection possible) }

FUNCTION GETIN(VAR TIMEREMAINING : INTEGER; VAR FROMCONSOLE : INTYPE):
  CHARACTER; ALIEN;
  { If connected, get character from host;
    otherwise, get character from terminal.
    Decrement timeremaining for each full second you wait;
    give up when timeleft gets to zero.
    If connected to host computer, and user types a character,
    set fromconsole accordingly }

PROCEDURE XMTCHAR(C : CHAR); ALIEN;
  { If connected, send character to host;
    otherwise send character to terminal }

PROCEDURE SYSFINISH; ALIEN;
  { If connected, disconnect.  System depedent clean up. }

PROCEDURE SLEEP(T: INTEGER); ALIEN;
  { Delay for T seconds }

PROCEDURE TTYRAW; ALIEN;
  { For host mode--put terminal into character by character mode.
    When in this mode, only GETIN and XMTCHAR are used to talk
    to the tty }

PROCEDURE TTYCOOKED; ALIEN;
  { Return terminal to normal I/O mode }

PROCEDURE FLUSH; ALIEN;
  { Flush any pending output }

PROCEDURE FILECREATE(FILENAME : MSTRING); ALIEN;
  { Create a file }

PROCEDURE FIXNAME(VAR FILENAME : STRING); ALIEN;
  { Fix up file name before sending it to other Kermit.
    Argument is 1 character per word in least significant bits }

FUNCTION BITWISE(i,j,result00,result01,result10,result11:integer):integer;
  { Perform bit-wise logical operation on two integers given the
    truth table:
                           |  bit in j=0  |  bit in j=1  |
               ------------+--------------+--------------+
               bit in i=0  |   result00   |   result01   |
               ------------+--------------+--------------+
               bit in i=1  |   result10   |   result11   |
               ------------+--------------+--------------+

    For negative numbers, use the fact that on a two's complement
    machine the bit-wise NOT of an integer "n" is "-1 - n".
    This works on machines that are not two's complement also,
    as long as we consistently use "-1 - n" as the NOT,
    and know how to interpret negative results. }
VAR bit, result: integer;
BEGIN
  if i < 0 then
    BITWISE := BITWISE(-1-i,j,result10,result11,result00,result01)
  else if j < 0 then
    BITWISE := BITWISE(i,-1-j,result01,result00,result11,result10)
  else if result00 <> 0 then
    BITWISE := -1 - BITWISE(i,j,0,1-result01,1-result10,1-result11)
  else
    BEGIN
      result := 0;
      bit := 1;
      WHILE (i > 0) AND (j > 0) DO
        BEGIN
          IF odd(i) THEN
            IF odd(j) THEN result := result + bit*result11
            ELSE result := result + bit*result10
          ELSE IF odd(j) THEN result := result + bit*result01;
          i := i DIV 2;
          j := j DIV 2;
          bit := bit + bit;
        END;
      BITWISE := result + bit*(i*result10 + j*result01);
    END;
END;

FUNCTION IAND(i,j:integer):integer;
BEGIN
  IAND := BITWISE(i,j,0,0,0,1);
END;

FUNCTION IOR(i,j:integer):integer;
BEGIN
  IOR := BITWISE(i,j,0,1,1,1);
END;

PROCEDURE fdbind(fd: filedesc; intname: mstring);
BEGIN
  CASE fd OF
    1: bind(input,intname,BindStatus);
    2: bind(output,intname,BindStatus);
    3: bind(file3,intname,BindStatus);
    4: bind(file4,intname,BindStatus);
    5: bind(file5,intname,BindStatus);
    6: bind(file6,intname,BindStatus);
    7: bind(file7,intname,BindStatus);
    8: bind(file8,intname,BindStatus);
    9: bind(file9,intname,BindStatus);
  END;
END;

PROCEDURE fdclose(fd: filedesc);
BEGIN
  CASE fd OF
    1: close(input);
    2: close(output);
    3: close(file3);
    4: close(file4);
    5: close(file5);
    6: close(file6);
    7: close(file7);
    8: close(file8);
    9: close(file9);
  END;
END;

FUNCTION fdeof(fd: filedesc): boolean;
BEGIN
  CASE fd OF
    1: fdeof := eof(input);
    2: fdeof := eof(output);
    3: fdeof := eof(file3);
    4: fdeof := eof(file4);
    5: fdeof := eof(file5);
    6: fdeof := eof(file6);
    7: fdeof := eof(file7);
    8: fdeof := eof(file8);
    9: fdeof := eof(file9);
  END;
END;

FUNCTION fdeoln(fd: filedesc): boolean;
BEGIN
  CASE fd OF
    1: fdeoln := eoln(input);
    2: fdeoln := eoln(output);
    3: fdeoln := eoln(file3);
    4: fdeoln := eoln(file4);
    5: fdeoln := eoln(file5);
    6: fdeoln := eoln(file6);
    7: fdeoln := eoln(file7);
    8: fdeoln := eoln(file8);
    9: fdeoln := eoln(file9);
  END;
END;

PROCEDURE fdread(fd: filedesc; VAR ch: char);
BEGIN
  CASE fd OF
    1: read(input,ch);
    2: read(output,ch);
    3: read(file3,ch);
    4: read(file4,ch);
    5: read(file5,ch);
    6: read(file6,ch);
    7: read(file7,ch);
    8: read(file8,ch);
    9: read(file9,ch);
  END;
END;

PROCEDURE fdreadln(fd: filedesc);
BEGIN
  CASE fd OF
    1: readln(input);
    2: readln(output);
    3: readln(file3);
    4: readln(file4);
    5: readln(file5);
    6: readln(file6);
    7: readln(file7);
    8: readln(file8);
    9: readln(file9);
  END;
END;

PROCEDURE fdreset(fd: filedesc);
BEGIN
  CASE fd OF
    1: reset(input);
    2: reset(output);
    3: reset(file3);
    4: reset(file4);
    5: reset(file5);
    6: reset(file6);
    7: reset(file7);
    8: reset(file8);
    9: reset(file9);
  END;
END;

PROCEDURE fdrewrite(fd: filedesc);
BEGIN
  CASE fd OF
    1: rewrite(input);
    2: rewrite(output);
    3: rewrite(file3);
    4: rewrite(file4);
    5: rewrite(file5);
    6: rewrite(file6);
    7: rewrite(file7);
    8: rewrite(file8);
    9: rewrite(file9);
  END;
END;

PROCEDURE fdwrite(fd: filedesc; ch: char);
BEGIN
  CASE fd OF
    1: write(input,ch);
    2: IF TtyMode = Cooked THEN write(output,ch)
       ELSE IF Trace THEN write(filet,ch);
    3: write(file3,ch);
    4: write(file4,ch);
    5: write(file5,ch);
    6: write(file6,ch);
    7: write(file7,ch);
    8: write(file8,ch);
    9: write(file9,ch);
  END;
END;

PROCEDURE fdwriteln(fd: filedesc);
BEGIN
  CASE fd OF
    1: writeln(input);
    2: IF TtyMode = Cooked THEN writeln(output)
       ELSE IF Trace THEN writeln(filet);
    3: writeln(file3);
    4: writeln(file4);
    5: writeln(file5);
    6: writeln(file6);
    7: writeln(file7);
    8: writeln(file8);
    9: writeln(file9);
  END;
END;

PROCEDURE WriteCharacter;
BEGIN
  write(ch);
END;

  PROCEDURE stiphalt; (* used by external procedures for halt *)
   BEGIN
     GOTO 9999;
   END;

  { initio  -- initialize open file list }
  PROCEDURE initio;
  VAR
    i :     filedesc;
   BEGIN
     filemode[STDIN] := IOREAD;
     filemode[STDOUT] := IOWRITE;
     filemode[lineout] := IOWRITE;
     filemode[linein] := IOREAD;

     { connect STDOUT to user's      terminal ... }
     fdrewrite(STDOUT);

     { initialize rest of files      }
     FOR i := linein+1 TO MAXOPEN DO
     filemode[i] := IOAVAIL;


   END;


  { getc (UCB) -- get one character from standard input }
  FUNCTION getc (VAR c : character) : character;
  VAR
    ch : char;
   BEGIN
     IF eof
      THEN
      c := ENDFILE
      ELSE
      IF eoln
       THEN
        BEGIN
          readln;
          c := NEWLINE
        END
       ELSE
        BEGIN
          read(ch);
          c := ord(ch)
        END;
     getc := c
   END;

  { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. }
  { getcf (UCB) -- get one character from file }
  FUNCTION getcf (VAR c: character; fd : filedesc) : character;
  VAR
    ch : char;
   BEGIN
     IF (filemode[fd] <> IOREAD)
      THEN
       BEGIN
         writeln('called getcf without file.mode=IOREAD'); stiphalt;
       END;
     IF (fd = STDIN)
      THEN
      getcf := getc(c)
      ELSE
      IF fdeof(fd)
       THEN
       c := ENDFILE
       ELSE
       IF fdeoln(fd)
        THEN
         BEGIN
           fdreadln(fd);
           c := NEWLINE
         END
        ELSE
         BEGIN
           fdread(fd, ch);
           c := ord(ch)
         END;
     getcf := c
   END;

  { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. }
  { getline (UCB) -- get a line from file }
  FUNCTION getline (VAR s : string; fd : filedesc;
                    maxsize : integer) : boolean;
  VAR
    i : integer;
    c : character;
   BEGIN
     i := 1;
      REPEAT
       s[i] := getcf(c, fd);
       i := i + 1
      UNTIL (c = ENDFILE) OR (c = NEWLINE) OR (i >= maxsize);
     IF (c = ENDFILE)
      THEN   { went one too far }
      i := i - 1;
     s[i] := ENDSTR;
     getline := (c <> ENDFILE)
   END;

  { putcf (UCB) -- put a single character on file fd }
  PROCEDURE putcf (c : character; fd : filedesc);
   BEGIN
     if (fd = lineout) then
         xmtchar(CHR(c))
     ELSE
     IF c = NEWLINE
      THEN
       fdwriteln(fd)
      ELSE
       fdwrite(fd, chr(c))
   END;

  { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. }
  { putstr (UCB) -- put out string on file }
  PROCEDURE putstr (VAR s : string; f : filedesc);
  VAR
    i : integer;
   BEGIN
     i := 1;
     WHILE (s[i] <> ENDSTR) DO
      BEGIN
        putcf(s[i], f);
        i := i + 1
      END
   END;

  { open  -- open a file for reading or   writing         }
  FUNCTION Sopen (VAR name : string; mode :   integer) : filedesc;
  VAR
    i :     integer;
    intname : mstring;
    found : boolean;
   BEGIN
     i := 1;
     WHILE (name[i] <> ENDSTR) AND (name[i] <> NEWLINE) AND
      (i <= FILENAMELENGTH)    DO
       BEGIN
         if name[i] >= LETA then name[i] := name[i] - 32;  { upper case }
         intname[i] := chr(name[i]);
         i := i + 1
       END;
     FOR i := i      TO FILENAMELENGTH DO
     intname[i]      := ' ';              { pad name         with blanks }
     { find a free slot      in openlist }
     Sopen := IOERROR;
     found := false;
     i := 1;
     WHILE (i <= MAXOPEN) AND (NOT found) DO
      BEGIN
        IF (filemode[i] = IOAVAIL)
         THEN
          BEGIN
            fdbind(i,intname);
            IF (BindStatus <> 0) AND (mode = IOWRITE) THEN
              BEGIN
                FILECREATE(intname);
                fdbind(i,intname);
              END;
            IF BindStatus = 0 THEN
              BEGIN
                filemode[i] :=     mode;
                IF (mode = IOREAD)
                 THEN
                  fdreset(i)
                 ELSE
                  fdrewrite(i);
                Sopen:=i;
              END
            ELSE Sopen := 0;
            found := true
          END;
        i := i + 1
      END
   END;

  PROCEDURE Sclose (fd : filedesc);
   BEGIN
     IF      (fd > STDOUT) AND (fd <= MAXOPEN)
      THEN
       BEGIN
         filemode[fd] := IOAVAIL;
         fdclose(fd);
       END
   END;

  { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. }
  { itoc - convert integer n to char string in s[i]... }
  FUNCTION itoc (n : integer; VAR s : string; i : integer)
    : integer;      { returns end of s }
   BEGIN
     IF (n < 0)
      THEN
       BEGIN
         s[i] := ord('-');
         itoc := itoc(-n, s, i+1)
       END
      ELSE
       BEGIN
         IF (n >= 10)
          THEN
          i := itoc(n DIV 10, s, i);
         s[i] := n MOD 10 + ord('0');
         s[i+1] := ENDSTR;
         itoc := i + 1
       END
   END;

  { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. }
  { length -- compute length of string }
  FUNCTION length (VAR s : string) : integer;
  VAR
    n : integer;
   BEGIN
     n := 1;
     WHILE (s[n] <> ENDSTR) DO
     n := n + 1;
     length := n - 1
   END;

  { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. }
  { scopy -- copy string at src[i] to dest[j] }
  PROCEDURE scopy (VAR src : string; i : integer;
                   VAR dest : string; j : integer);
   BEGIN
     WHILE (src[i] <> ENDSTR) DO
      BEGIN
        dest[j] := src[i];
        i := i + 1;
        j := j + 1
      END;
     dest[j] := ENDSTR
   END;

  { copyright (c) 1981 university of toronto computing services }
  { isupper -- true if c is upper case letter }
  { kludge version for omsi pascal }
  FUNCTION isupper (c : character) : boolean;
   BEGIN
     isupper := (c >= ord('A')) AND (c <= ord('Z'))
   END;

  { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. }
  { index -- find position of character c in string s }
  FUNCTION index (VAR s : string; c : character) : integer;
  VAR
    i : integer;
   BEGIN
     i := 1;
     WHILE (s[i] <> c) AND (s[i] <> ENDSTR) DO
     i := i + 1;
     IF (s[i] = ENDSTR)
      THEN
      index := 0
      ELSE
      index := i
   END;

  FUNCTION getarg(n:integer;VAR   s:string;maxsize:integer): BOOLEAN;
    (* return the nth argument *)
   BEGIN
     IF      ((n<1) OR (cmdargs<n))
      THEN
      getarg :=       false
      ELSE
       BEGIN
         scopy(cmdlin,cmdidx[n],s,1);
         getarg  := true
       END;
   END;

  FUNCTION nargs: integer; (* returns number arguments *)
   BEGIN
     nargs := cmdargs
   END;

  PROCEDURE CtoS((* Using *) x:cstring; (* Returning *) VAR s:string);
    (* convert constant to STIP string *)
  VAR
    i : integer;
   BEGIN
     FOR i:=1 TO CONLENGTH DO
     s[i] := ord(x[i]);
     s[CONLENGTH+1] := ENDSTR;
   END;

  PROCEDURE PutCon((* Using *) x:cstring;
                   (* Using *)      fd:filedesc);
    (* output literal preceeded by NEWLINE *)
  VAR
    i: integer;
    s: string;
   BEGIN
     s[1] := NEWLINE;
     s[2] := ENDSTR;
     putstr(s,fd);
     CtoS(x,s);
     putstr(s,fd);
   END;

  FUNCTION Exists((* Using *) name:string): (* Returning *) boolean;
    (* returns true if file exists *)
  VAR
    i :     integer;
    intname : mstring;
   BEGIN
     i := 1;
     WHILE (name[i] <> ENDSTR) AND (name[i] <> NEWLINE) AND
      (i <= FILENAMELENGTH) DO
       BEGIN
         intname[i] := chr(name[i]);
         i := i + 1
       END;
     FOR i := i      TO FILENAMELENGTH DO
     intname[i]      := ' ';              { pad name         with blanks }
     bind(filen,intname,BindStatus);
     Exists := (BindStatus = 0);
   END;

  PROCEDURE PutNum((* Using *) n:integer;
                   (* Using *) fd:filedesc);
    (* Ouput number *)
  VAR
    s: string;
    dummy: integer;
   BEGIN
     s[1] := BLANK;
     dummy := itoc(n,s,2);
     putstr(s,fd);
   END;

  PROCEDURE initcmd;  (*  read command line *)
  VAR
    idx     : 1.. MAXSTR;
    i:integer;
    prom:cstring;
    dummy : boolean;
   BEGIN
     prom := 'KERMIT-H>           ';        (*         Prompt  *)
     PutCon(prom,STDOUT);
     dummy :=  getline(cmdlin,STDIN,MAXSTR);
     IF (cmdlin[1] <> ENDSTR)
      THEN
      FOR i:= 1       TO length(cmdlin) DO begin
      IF isupper(cmdlin[i])
       THEN cmdlin[i]:=cmdlin[i] + 32;
       IF (cmdlin[i]=newline) then CMDLIN[I]:=ENDSTR;
       end;

     cmdargs :=      0;    (*  initialize *)

     idx := 1;

     WHILE (cmdlin[idx]<>endstr)
     DO
      BEGIN
        WHILE (cmdlin[idx]=blank) DO
        idx := idx+1;
        IF (cmdlin[idx]<>endstr)
         THEN
          BEGIN
            cmdargs := cmdargs+1;
            cmdidx[cmdargs] := idx;
            WHILE  (cmdlin[idx]<>endstr)
                   AND (cmdlin[idx]<>BLANK) DO
            idx     := idx+1;
            cmdlin[idx]     := ENDSTR;
            idx     := idx+1;
          END;
      END;
   END;

  PROCEDURE AddTo((* Updating *) VAR sum : Stats;
                  (* Using *)  inc:integer);

    (* This is used to avoid integer overflows
     without using 'reals' *)

   BEGIN
     sum[Low] := sum[Low] + inc;
     IF (sum[Low] >= 1000)
      THEN
       BEGIN
         sum[High] := sum[High] +1;
         sum[Low ] := sum[Low] - 1000;
       END;
   END;

  PROCEDURE OverHd((* Using *)  p,f: Stats;
                   (* Returning *) VAR o:integer);

    (* Calculate OverHead as % *)
    (* 0verHead := (p-f)*100/f *)

   BEGIN
     o:= 0;
   END;

  PROCEDURE CalRat((* Using *) f: Stats;
                   (* Using *) t:integer;
                   (* Returning *) VAR r:integer);

    (* Calculate Effective Baud Rate *)
    (* Rate = f*10/t *)

   BEGIN
     r := 0;
   END;

  FUNCTION UnChar((* Using *) c:character): (* Returning *) character;
    (* reverse of makechar *)
   BEGIN
     UnChar := c-BLANK
   END;

  PROCEDURE PutOut( p : Ppack); (* Output Packet *)
  VAR
    i : integer;
   BEGIN
     IF (Pad >0)
      THEN
      FOR i := 1 TO Pad DO
      putcf(PadChar,LineOut);
     WITH Buf[p] DO
      BEGIN
        putcf(mark,LineOut);
        putcf(count,LineOut);
        PutCon ( 'Sending Packet...   ',STDout);
        PutNum(Unchar(seq),STDout);
        putcf(seq,LineOut);
        putcf(ptype,LineOut);
        putstr(data,LineOut);
      END;
   END;

  PROCEDURE StartTimer;
   BEGIN
     TimeLeft := TheirTimeOut;
   END;

  PROCEDURE StopTimer;
   BEGIN
     TimeLeft := MaxInt;
   END;

  FUNCTION MakeChar((* Using *) c:character): (* Returning *) character;
    (* convert integer to printable *)
   BEGIN
     MakeChar := c+BLANK;
   END;

  FUNCTION IsControl((* Using *) c:character): (* Returning *) boolean;
    (* true if control *)
   BEGIN
     IsControl := (c=DEL ) OR (c < BLANK );
   END;

  FUNCTION IsPrintable((* Using *) c:character): (* Returning *) boolean;
    (* opposite of iscontrol *)
   BEGIN
     IsPrintable := NOT IsControl(c);
   END;

  FUNCTION Ctl((* Using *) c:character): (* Returning *) character;
    (* c XOR 100 *)
   BEGIN
     IF IsControl(c)
      THEN
      c := c+64
      ELSE
      c := c-64;
     Ctl := c;
   END;

  FUNCTION IsValidPType((* Using *) c:character): (* Returning *) boolean;
    (* true if valid packet type *)
   BEGIN
     IsValidPType := (c =TYPEB) OR (c=TYPED) OR (c=TYPEE) OR (c=TYPEF)
     OR (c=TYPEN) OR (c=TYPES) OR (c=TYPET) OR (c=TYPEY) OR (c=TYPEZ)
   END;

  FUNCTION CheckFunction((* Using *) c:integer): (* Returning *) character;
    (* calculate checksum *)
  VAR
    x: integer;
   BEGIN
     (*   CheckFunction := (c + ( c AND 300 ) /100 ) AND 77; *)
     x := (c MOD 256 ) DIV 64;
     x := x+c;
     CheckFunction := x MOD 64;
   END;

  PROCEDURE EnCodeParm((* Updating *) VAR data:string);  (* encode parameters *)
  VAR
    i: integer;
   BEGIN
     FOR i:=1 TO NUMPARAM DO
     data[i] := BLANK;
     data[NUMPARAM+1] := ENDSTR;
     data[1] := MakeChar(SizeRecv);     (* my biggest packet *)
     data[2] := MakeChar(MyTimeOut);         (* when I want timeout*)
     data[3] := MakeChar(MyPad);             (* how much padding *)
     data[4] := Ctl(MyPadChar);              (* my padding character *)
     data[5] := MakeChar(myEOL);             (* my EOL *)
     data[6] := MyQuote;                     (* my quote char *)
   END;

  PROCEDURE DeCodeParm((* Using *) VAR data:string); (* decode parameters *)
   BEGIN
     SizeSend := UnChar(data[1]);
     TheirTimeOut := UnChar(data[2]);   (* when I should time out *)
     Pad := UnChar(data[3]);            (* padding characters to send  *)
     PadChar := Ctl(data[4]);           (* padding character *)
     SendEOL := UnChar(data[5]);        (* EOL to send *)
     SendQuote := data[6];              (* quote to send *)
   END;

  PROCEDURE ReadParm ((* Updating *) VAR Parms:string);
  VAR
    dummy : boolean;
    fd : filedesc;
   BEGIN;

     (* read parameters *)
     Parms[1]:=ENDSTR;
     IF Exists(ParmFile)
      THEN
       BEGIN
         fd := Sopen(ParmFile,IOREAD);
         dummy := getline(Parms,fd,MAXSTR);
         Sclose(fd);
       END;
   END;

  PROCEDURE GetParm; (* get parameters from file *)
  VAR
    data:string;
   BEGIN;
     ReadParm(data);
     IF (length(data) > 0)
      THEN      (* get parameters *)
       BEGIN
         SizeRecv := UnChar(data[1]);
         MyTimeOut := UnChar(data[2]);   (* when I should time out *)
         MyPad := UnChar(data[3]);     (* padding characters to send  *)
         MyPadChar := Ctl(data[4]);       (* padding character *)
         MyEOL := UnChar(data[5]);        (* EOL to send *)
         MyQuote := data[6];              (* quote to send *)
       END;
   END;

  PROCEDURE SYSarguments;
    (* process special arguments for SYSTEM *)
   BEGIN
     (* nothing *)
   END;

  PROCEDURE StartRun; (* initialization as necessary *)
   BEGIN
     RunTime := 0;
   END;

  PROCEDURE Usage;  (* Print writeln & exit *)
   BEGIN
     writeln;
     writeln(
       'usage: KERMIT-H> [Help] [Connect] [Send/Receive/Print<filenames>]');
   END;

  PROCEDURE SetParameters;
    (* set new Parameter File Name *)
   BEGIN
     IF (length(aline) > 2)
      THEN
       BEGIN
         scopy(aline,3,ParmFile,1);
         GetParm; (* read new parameters *)
       END;
   END;

  PROCEDURE KermitInit;  (* initialize various parameters  & defaults *)
   BEGIN
     n := 0;

     NumSendPacks := 0;
     NumRecvPacks := 0;
     NumACK := 0;
     NumNAK := 0;
     NumACKrecv := 0;
     NumNAKrecv := 0;
     NumBADrecv := 0;

     ChInFile[Low] := 0;
     ChInFile[High] := 0;
     ChInPack := ChInFile;

     OneWayOnly := false;
     Verbosity := false;       (* default to false *)
     Trace := false;           (* default to no trace *)
     Debug := false;
     RunType := invalid;
     DiskFile := IOERROR;      (* to indicate not open yet *)

     ThisPacket := 1;
     LastPacket := 2;
     CurrentPacket := 3;
     NextPacket := 4;
     InputPacket := 5;

     WITH TOPacket DO
      BEGIN
        count := 3;
        seq := 0;
        ptype := TYPEN;
        data[1] := ENDSTR;
      END;

     NextArg := 1;          (* get first argument *)
     IF (NextArg<=nargs)
      THEN
      IF  NOT getarg(NextArg,aline,MAXSTR)
       THEN
       Usage;

     FROMCONSOLE:=NOTHING;

   END;

  PROCEDURE FinishUp; (* do any End of Program clean up *)
  VAR
    overhead ,effrate : integer;
   BEGIN
     Sclose(DiskFile);
     (* print info on number of packets etc *)
     IF ((RunType <> Invalid) AND Local )
      THEN
       BEGIN
         PutCon('Packets sent:       ',STDOUT);
         PutNum(NumSendPacks,STDOUT);
         PutCon('Packets received    ',STDOUT);
         PutNum(NumRecvPacks,STDOUT);
         (* Calculate overhead *)
         OverHd(ChInPack,ChInFile,overhead);
         IF (Overhead <>0)
          THEN
           BEGIN
             PutCon('Overhead (%):       ' ,STDOUT);
             PutNum(overhead,STDOUT);
           END;
         IF (RunTime <> 0)
          THEN
           BEGIN (* calculate effective rate *)
             CalRat(ChInFile,RunTime,effrate);
             PutCon('Effective Rate:     ',STDOUT);
             PutNum(effrate,STDOUT);
           END;
         IF (RunType = Transmit)
          THEN
           BEGIN
             PutCon('Number of ACK:      ',STDOUT);
             PutNum(NumACKrecv,STDOUT);
             PutCon('Number of NAK:      ',STDOUT);
             PutNum(NumNAKrecv,STDOUT);
             PutCon('Number of BAD:      ',STDOUT);
             PutNum(NumBADrecv,STDOUT);
           END
          ELSE
           BEGIN   (* for Receive *)
             PutCon('Number of ACK:      ',STDOUT);
             PutNum(NumACK,STDOUT);
             PutCon('Number of NAK:      ',STDOUT);
             PutNum(NumNAK,STDOUT);
           END;
         putcf(NEWLINE,STDOUT);
       END;
     State := Abort;
     Local := false;
   END;

  PROCEDURE DebugPacket((* Using *)    mes : cstring;
                        (* Using *)  VAR p : Ppack);
    (* Print Debugging Info *)
   BEGIN
     PutCon(mes,STDOUT);
     WITH Buf[p] DO
      BEGIN
        PutNum(Unchar(count),STDOUT);
        PutNum(Unchar(seq),STDOUT);
        putcf(BLANK,STDOUT);
        putcf(ptype,STDOUT);
        putcf(NEWLINE,STDOUT);
        putstr(data,STDOUT);
        putcf(NEWLINE,STDOUT);
      END;
   END;

  PROCEDURE ReSendPacket;
    (* re -sends previous packet *)
   BEGIN
     NumSendPacks := NumSendPacks+1;
     AddTo(ChInPack,Pad + UnChar(Buf[LastPacket].count) + 3);
     IF Debug
      THEN DebugPacket('Re-Sending ...      ',LastPacket);
     PutOut(LastPacket);
   END;

  PROCEDURE SendPacket;

    (* expects count as length of data portion *)
    (* and seq as number of packet *)
    (* builds & sends packet *)
  VAR
    i,len,chksum : integer;
    temp : Ppack;
   BEGIN
     IF (NumTry <> 1) AND (RunType = Transmit )
      THEN
      ReSendPacket
      ELSE
       BEGIN
         WITH Buf[ThisPacket] DO
          BEGIN
            mark :=SOH;               (* mark *)
            len := count;             (* save length *)
            count := MakeChar(len+3); (* count = 3+length of data *)
            seq := MakeChar(seq);     (* seq number *)
            chksum := count + seq + ptype;
            IF ( len > 0)
             THEN      (* is there data ? *)
             FOR i:= 1 TO len DO
             chksum := chksum + data[i];       (* loop for data *)
            chksum := CheckFunction(chksum);  (* calculate  checksum *)
            data[len+1] := MakeChar(chksum);  (* make printable & output *)
            data[len+2] := SendEOL;                    (* EOL *)
            data[len+3] := ENDSTR;
          END;

         NumSendPacks := NumSendPacks+1;
         IF Debug
          THEN DebugPacket('Sending ...         ',ThisPacket);
         PutOut(ThisPacket);

         IF RunType = Transmit
          THEN
           BEGIN
             AddTo(ChInPack,Pad + len + 6);
             temp := LastPacket;
             LastPacket := ThisPacket;
             ThisPacket := temp;
           END;
       END

   END;

  PROCEDURE SendACK((* Using *) n:integer); (* send ACK packet *)
   BEGIN
     WITH Buf[ThisPacket] DO
      BEGIN
        count := 0;
        seq := n;
        ptype := TYPEY;
      END;
     SendPacket;
     NumACK := NumACK+1;
   END;

  PROCEDURE SendNAK((* Using *) n:integer); (* send NAK packet *)
   BEGIN
     WITH Buf[ThisPacket] DO
      BEGIN
        count := 0;
        seq := n;
        ptype := TYPEN;
      END;
     SendPacket;
     NumNAK := NumNAK+1;
   END;

  PROCEDURE ErrorPack((* Using *) c:cstring);
    (* output Error packet if necessary -- then exit *)
   BEGIN
     IF (TTYmode = Cooked)
      THEN
      PutCon(c,STDOUT)
      ELSE
       BEGIN
         WITH Buf[ThisPacket] DO
          BEGIN
            seq := n;
            ptype := TYPEE;
            CtoS(c,data);
            count := length(data);
          END;
         SendPacket;
       END;
     FinishUp;
     State := Abort;
   END;

  PROCEDURE Verbose((* Using *) c:cstring);
    (* Print writeln if verbosity *)
   BEGIN
     IF Verbosity
      THEN
      PutCon(c,STDOUT);
   END;

  PROCEDURE PutErr((* Using *) c:cstring);
    (* Print error_messages *)
   BEGIN
     PutCon(c,STDOUT);
     IF (TtyMode = Raw) AND (NumKeptErrors < MAXERRORS)
      THEN
       BEGIN
         NumKeptErrors := NumKeptErrors + 1;
         KeptErrors[NumKeptErrors] := c;
       END;
   END;

  PROCEDURE Field1; (* Count *)
  VAR
    test: boolean;
   BEGIN
     WITH Buf[NextPacket] DO
      BEGIN
        WITH PackControl DO
         BEGIN
           Buf[InputPacket].count := t;
           count := UnChar(t);
           test := (count >= 3) OR (count <= SizeRecv-2);
           IF NOT test
            THEN
            Verbose('Bad count           ');
           good := good AND test;
         END;
      END;
   END;

  PROCEDURE Field2; (* Packet Number *)
  VAR
    test : boolean;
   BEGIN
     WITH Buf[NextPacket] DO
      BEGIN
        WITH PackControl DO
         BEGIN
           Buf[InputPacket].seq := t;
           seq := UnChar(t);
           test := (seq >= 0) OR (seq <= 63);
           IF NOT test
            THEN
            Verbose('Bad seq number      ');
           good := test AND good;
         END;
      END;
   END;

  PROCEDURE Field3; (* Packet Type *)
  VAR
    test : boolean;
   BEGIN
     WITH Buf[NextPacket] DO
      BEGIN
        WITH PackControl DO
         BEGIN
           ptype := t;
           Buf[InputPacket].ptype := t;
           test := IsValidPType(ptype);
           IF NOT test
            THEN
            Verbose('Bad Packet Type     ');
           good := test AND good;
         END;
      END;
   END;

  PROCEDURE Field4; (* Data *)
   BEGIN
     WITH PackControl DO
      BEGIN
        PacketPtr := PacketPtr+1;
        Buf[InputPacket].data[PacketPtr] := t;
        WITH Buf[NextPacket] DO
         BEGIN
           IF (t=MyQuote) AND (ptype <> TYPEY) AND (ptype <> TYPES)
            THEN    (* character is quote *)
             BEGIN
               IF control
                THEN        (* quote ,quote  *)
                 BEGIN
                   data[i] := MyQuote;
                   i := i+1;
                   control := false;
                 END
                ELSE      (* set control on *)
                control := true
             END
            ELSE                 (* not quote *)
            IF control
             THEN      (* convert to control *)
              BEGIN
                data[i] := ctl(t);
                i := i+1;
                control := false
              END
             ELSE      (* regular data *)
              BEGIN
                data[i] := t;
                i := i+1;
              END;
         END;
      END;
   END;

  PROCEDURE Field5; (* Check Sum *)
  VAR
    test : boolean;
   BEGIN
     WITH PackControl DO
      BEGIN
        PacketPtr := PacketPtr +1;
        Buf[InputPacket].data[PacketPtr] := t;
        Buf[InputPacket].data[PacketPtr + 1] := ENDSTR;
        check := CheckFunction(check);
        check := MakeChar(check);
        test := (t=check);
        IF NOT test
         THEN
         Verbose('Bad CheckSum        ');
        good := test AND good;
        Buf[NextPacket].data[i] := ENDSTR;
        finished := true;  (* set finished *)
      END;
   END;

  PROCEDURE BuildPacket;
    (* receive packet & validate checksum *)
  VAR
    temp : Ppack;
   BEGIN
     WITH PackControl DO
      BEGIN
        WITH Buf[NextPacket] DO
         BEGIN
           IF (t<>ENDSTR)
            THEN
            IF restart
             THEN
              BEGIN
                (* read until get SOH marker *)
                IF  (t = SOH)
                 THEN
                  BEGIN
                    finished := false;    (* set varibles *)
                    control := false;
                    good := true;
                    seq := -1;        (* set return values to bad packet *)
                    ptype := QUESTION;
                    data[1] := ENDSTR;
                    data[MAXSTR] := ENDSTR;
                    restart := false;
                    fld := 0;
                    i := 1;
                    PacketPtr := 0;
                    check := 0;
                  END;
              END
             ELSE                          (* have started packet *)
              BEGIN
                IF (t=SOH)          (* check for restart or EOL *)
                 THEN
                 restart := true
                 ELSE
                 IF (t=myEOL)
                  THEN
                   BEGIN
                     finished := true;
                     good := false;
                   END
                  ELSE
                   BEGIN
                     CASE fld OF
                       (* increment field number *)
                       0:   fld := 1;
                       1:   fld := 2;
                       2:   fld := 3;
                       3:
                       IF (count=3)  (* no data *)
                        THEN
                        fld := 5
                        ELSE
                        fld := 4;
                       4:
                       IF (PacketPtr>=count-3) (* end of data *)
                        THEN
                        fld := 5;
                      END (* case *);
                     IF (fld<>5)
                      THEN
                      check := check+t; (* add into checksum *)

                     CASE fld OF
                       1:      Field1;
                       2:      Field2;
                       3:      Field3;
                       4:      Field4;
                       5:      Field5;
                      END;
                     (* case *)
                   END;
              END;

           IF finished
            THEN
             BEGIN
               IF (ptype=TYPEE)  AND good
                THEN   (* error_packets *)
                 BEGIN
                   putstr(data,STDOUT);
                   FinishUp;
                   SendACK(n);          (* send ACK *)
                 END;
               NumRecvPacks := NumRecvPacks+1;
               IF Debug
                THEN
                 BEGIN
                   DebugPacket('Received ...        ',InputPacket);
                   IF good
                    THEN
                    PutCon('Is Good             ',STDOUT);
                 END;

               temp := CurrentPacket;
               CurrentPacket := NextPacket;
               NextPacket := temp;
             END;
         END;
      END;
   END;

  FUNCTION ReceivePacket: boolean;
   BEGIN
     WITH PackControl DO
      BEGIN
        StartTimer;
        IF (Runtype = Receive) AND (State = Init) THEN
         TimeLeft := 10 * TimeLeft;    { Long wait for first message }
        finished := false;
        restart := true;
        good := false;
        FromConsole := nothing;  (* No Interupt *)
         REPEAT
          t := GetIn(TimeLeft,FromConsole);
          IF Local   (* check Interupt *)
           THEN BEGIN
           CASE FromConsole OF
             abortnow:
              BEGIN
                FinishUp;
                STIPHALT;
              END;
             nothing:        (* nothing *);
             CRin:
              BEGIN
                t := MyEOL;
                FromConsole := nothing;
              END;
            END;
           end;
           (* case *)
          BuildPacket;
         UNTIL finished  OR (TimeLeft = 0);
        IF (TimeLeft = 0)
         THEN
          BEGIN
            Buf[CurrentPacket] := TOPacket;
            restart := true;
            IF NOT ((RunType=Transmit) AND (State=Init))
             THEN
              BEGIN
                PutCon('Timed Out           ',STDOUT);
              END;
          END;
        StopTimer;
        ReceivePacket := good;
      END;
   END;

  FUNCTION ReceiveACK : (* Returning *) boolean;
    (* receive ACK with correct number *)
  VAR
    Ok: boolean;
   BEGIN
     IF (NOT OneWayOnly )
      THEN
      Ok := ReceivePacket;
     WITH Buf[CurrentPacket] DO
      BEGIN
        IF (ptype=TYPEY)
         THEN
         NumACKrecv := NumACKrecv+1
         ELSE
         IF (ptype=TYPEN)
          THEN
          NumNAKrecv := NumNAKrecv+1
          ELSE
          IF NOT OneWayOnly
           THEN
           NumBadrecv := NumBadrecv +1;
           (* got right one ? *)
        ReceiveACK := ( Ok AND (ptype=TYPEY) AND (n=seq))
        OR  ( OneWayOnly)
      END;
   END;

  PROCEDURE GetData((* Returning *)   VAR newstate:KermitStates);
    (* get data from file into ThisPacket *)
  VAR
    (* and return next state - data &  EOF *)
    x,c : character;
    i: integer;
   BEGIN
     IF (NumTry=1)
      THEN
       BEGIN
         i := 1;
         x := ENDSTR;
         WITH Buf[ThisPacket] DO
          BEGIN
            WHILE (i< SizeSend - 8 ) AND (x <> ENDFILE)
            (* leave room for quote  & NEWLINE *)
            DO
             BEGIN
               x := getcf(c,DiskFile);
               IF (x<>ENDFILE)
                THEN
                IF (IsControl(x)) OR (x=SendQuote)
                 THEN
                  BEGIN           (* control char -- quote *)
                    IF (x=NEWLINE)
                     THEN      (* use proper EOL *)
                     CASE EOLforFile OF
                       LineFeed:   (* ok as is *);
                       CrLf:
                        BEGIN
                          data[i] := SendQuote;
                          i := i+1;
                          data[i] := Ctl(CR);
                          i := i+1;
                          (* LF will sent
                           below *)
                        END;
                       JustCR:     x := CR;
                      END (* case *);
                    data[i] := SendQuote;
                    i := i+1;
                    IF (x<>SendQuote)
                     THEN
                     data[i] := Ctl(x)
                     ELSE
                     data[i] := SendQuote;
                  END
                 ELSE               (* regular char *)
                 data[i] := x;

               IF (x<>ENDFILE)
                THEN
                 BEGIN
                   i := i+1;    (* increase count for next char *)
                   AddTo(ChInFile,1);
                 END;
             END;

            data[i] := ENDSTR;   (* to terminate string *)

            count := i -1;       (* length *)
            seq := n;
            ptype := TYPED;

            IF (x=ENDFILE)
             THEN
              BEGIN
                newstate := EOFile;
                Sclose(DiskFile);
                DiskFile := ioerror;
              END
             ELSE
             newstate := FileData;
            SaveState := newstate;        (* save state *)
          END
       END
      ELSE
      newstate := SaveState;        (* get old state *)
   END;

  FUNCTION GetNextFile: (* Returning *) boolean;
    (* get next file to send in ThisPacket *)
    (* returns true if no more *)
  VAR
    result: boolean;
   BEGIN
     result := true;
     IF (NumTry=1)
      THEN
      WITH Buf[ThisPacket] DO
       BEGIN
          REPEAT
           IF getarg(NextArg,data,MAXSTR)
            THEN
             BEGIN            (* open file  *)
               IF Exists(data)
                THEN
                 BEGIN
                   DiskFile := Sopen(data,IOREAD);
                   count := length(data);
                   AddTo(ChInFile , count);
                   seq := n;
                   ptype := TYPEF;
                   PutCon(' SENDING...         ',STDOUT);
                   putstr(data,stdout);
                   IF DiskFile <= IOERROR
                    THEN
                    ErrorPack('Cannot open file    ');
                   result := false;
                   FIXNAME(data);
                 END;
             END;
           NextArg := NextArg+1;
          UNTIL ( NextArg > nargs ) OR ( NOT result )
       END
      ELSE
      result := false; (* for saved packet *)
     GetNextFile := result;
   END;

  PROCEDURE SendFile; (* send file name packet *)
   BEGIN
     Verbose( 'Sending ....        ');
     IF NumTry > MaxTry
      THEN
       BEGIN
         PutErr ('Send file - Too Many');
         State := Abort;      (* too many tries, abort *)
       END
      ELSE
       BEGIN
         NumTry := NumTry+1;
         IF GetNextFile
          THEN
           BEGIN
             State := Break;
             NumTry := 0;
           END
          ELSE
           BEGIN
             IF Verbosity
              THEN
              IF (NumTry = 1)
               THEN putstr(Buf[ThisPacket].data,STDOUT)
               ELSE putstr(Buf[LastPacket].data,STDOUT);
             SendPacket;     (* send this packet *)
             IF ReceiveACK
              THEN
               BEGIN
                 State := FileData;
                 NumTry := 0;
                 n := (n+1) MOD 64;
               END
           END;
       END;
   END;

  PROCEDURE SendData;  (* send file data packets *)
  VAR
    newstate: KermitStates;
   BEGIN
     IF Verbosity
      THEN
       BEGIN
         PutCon ( 'Sending data        ',STDOUT);
         PutNum(n,STDOUT);
       END;
     IF NumTry > MaxTry
      THEN
       BEGIN
         State := Abort;       (* too many tries, abort *)
         PutErr ('Send data - Too many');
       END
      ELSE
       BEGIN
         NumTry := NumTry+1;
         GetData(newstate);
         SendPacket;
         IF ReceiveACK
          THEN
           BEGIN
             State := newstate;
             NumTry := 0;
             n := (n+1) MOD 64;
           END
       END;
   END;

  PROCEDURE SendEOF;    (* send EOF  packet *)
   BEGIN
     Verbose ('Sending EOF         ');
     IF NumTry > MaxTry
      THEN
       BEGIN
         State := Abort;       (* too many tries, abort *)
         PutErr('Send EOF - Too Many ');
       END
      ELSE
       BEGIN
         NumTry := NumTry+1;
         IF (NumTry = 1)
          THEN
           BEGIN
             WITH Buf[ThisPacket] DO
              BEGIN
                ptype := TYPEZ;
                seq := n;
                count := 0;
              END
           END;
         SendPacket;
         IF ReceiveACK
          THEN
           BEGIN
             State := FileHeader;
             NumTry := 0;
             n := (n+1) MOD 64;
           END
       END;
   END;

  PROCEDURE SendBreak; (* send break packet *)
   BEGIN
     Verbose ('Sending break       ');
     IF NumTry > MaxTry
      THEN
       BEGIN
         State := Abort;       (* too many tries, abort *)
         PutErr('Send break -Too Many');
       END
      ELSE
       BEGIN
         NumTry := NumTry+1;
         (* make up packet  *)
         IF NumTry = 1
          THEN
           BEGIN
             WITH Buf[ThisPacket] DO
              BEGIN
                ptype := TYPEB;
                seq := n;
                count := 0;
              END
           END;
         SendPacket; (* send this packet *)
         IF ReceiveACK
          THEN
           BEGIN
             State := Complete;
           END
       END;
   END;

  PROCEDURE SendInit;  (* send init packet *)
   BEGIN
     Verbose ('Sending init        ');
     IF NumTry > MaxTry
      THEN
       BEGIN
         State := Abort;      (* too many tries, abort *)
         PutErr('Cannot Initialize   ');
       END
      ELSE
       BEGIN
         NumTry := NumTry+1;
         IF (NumTry = 1)
          THEN
           BEGIN
             WITH Buf[ThisPacket] DO
              BEGIN
                EnCodeParm(data);
                count := NUMPARAM;
                seq := n;
                ptype := TYPES;
              END
           END;

         SendPacket; (* send this packet *)
         IF ReceiveACK
          THEN
           BEGIN
             WITH Buf[CurrentPacket] DO
              BEGIN
                IF OneWayOnly
                 THEN  (* use same data if test mode *)
                 data := Buf[LastPacket].data;
                SizeSend := UnChar(data[1]);
                TheirTimeOut := UnChar(data[2]);
                Pad := UnChar(data[3]);
                PadChar := Ctl(data[4]);
                SendEOL := CR;  (* default to CR *)
                IF (length(data) >= 5)
                 THEN
                 IF (data[5] <> 0)
                  THEN
                  SendEOL := UnChar(data[5]);
                SendQuote := SHARP;  (* default # *)
                IF (length(data) >= 6)
                 THEN
                 IF (data[6] <> 0)
                  THEN
                  SendQuote := data[6];
              END;

             State := FileHeader;
             NumTry := 0;
             n := (n+1) MOD 64;
           END;
       END;
   END;

  PROCEDURE SendSwitch;
    (* Send-switch is the state table switcher for sending files.
     * It loops until either it is finished or a fault is encountered.
     * Routines called by sendswitch are responsible for changing the state.
     *)

   BEGIN
     State := Init;              (* send initiate is the start state *)
     NumTry := 0;                (* say no tries yet *)
     IF NOT Local THEN
       BEGIN
         TTYRAW;                 (* if host--put tty in raw mode *)
         TtyMode := Raw;
       END;
     IF (NOT OneWayOnly )
      THEN
      Sleep(Delay);
     StartRun;
      REPEAT
       CASE State OF
         FileData:     SendData;         (* data-send state *)
         FileHeader:   SendFile;         (* send file name *)
         EOFile:       SendEOF;          (* send end-of-file *)
         Init:         SendInit;         (* send initialize *)
         Break:        SendBreak;        (* send break *)
         Complete:     (* nothing *);
         Abort:        (* nothing *);
        END (* case *);
      UNTIL ( (State = Abort) OR (State=Complete) );
     FLUSH;                      (* flush output buffer *)
     IF TtyMode = Raw THEN
       BEGIN
         TTYCOOKED;              (* if host--return tty to cooked mode *)
         TtyMode := Cooked;
       END;
   END;

  PROCEDURE GetFile((* Using *) data:string);
    (* create file from fileheader packet *)
  VAR
    strend: integer;
   BEGIN
     putstr(aline,stdout);
     IF (RUNTYPE=PRINT) THEN  DiskFile := Sopen(aline,IOWRITE) ELSE
     WITH Buf[CurrentPacket] DO
      BEGIN
        IF DiskFile = IOERROR      (* check if we already have a file *)
         THEN
          BEGIN
            IF Verbosity
             THEN
              BEGIN
                PutCon ('Creating file ...   ',STDOUT);
                putstr(data,STDOUT);
              END;
             (* check position of '.' -- truncate if bad *)
            IF (index(data,PERIOD) > FLEN1 )
             THEN
              BEGIN
                data[FLEN1] := PERIOD;
                data[FLEN1 + 1] := ENDSTR;
              END;
             (* check Max length *)
            IF length(data) > FLEN2
             THEN
             data[FLEN2 +1] := ENDSTR;
            IF Exists(data)
             THEN
              BEGIN
                PutCon('File already exists ',STDOUT);
                putstr(data,STDOUT);
                PutCon('Creating  ...       ',STDOUT);
                CtoS(TEMPFILE,data);
                strend := 0;
                 REPEAT
                  strend := strend +1;
                 UNTIL (data[strend] = BLANK);
                strend := itoc(n,data,strend);
                putstr(data,STDOUT);
              END;
            DiskFile := Sopen(data,IOWRITE);
          END;
        IF (Diskfile <= IOERROR)
         THEN
         ErrorPack('Cannot create file  ');
      END;
   END;

  PROCEDURE ReceiveInit;
    (* receive init packet *)
    (* respond with ACK and  our parameters *)
   BEGIN
     IF NumTry > MaxTry
      THEN
       BEGIN
         State := Abort;
         PutErr('Cannot receive init ');
       END
      ELSE
       BEGIN
         Verbose ( 'Receiving Init      ');
         NumTry := NumTry+1;
         IF ReceivePacket
          AND (Buf[CurrentPacket].ptype = TYPES)
          THEN
           BEGIN
             WITH Buf[CurrentPacket] DO
              BEGIN
                n := seq;
                DeCodeParm(data);
              END;

             (* now send mine *)
             WITH Buf[ThisPacket] DO
              BEGIN
                count := NUMPARAM;
                seq := n;
                Ptype := TYPEY;
                EnCodeParm(data);
              END;

             SendPacket;

             NumACK := NumACK+1;
             State := FileHeader;
             OldTry := NumTry;
             NumTry := 0;
             n := (n+1) MOD 64
           END
          ELSE
           BEGIN
             IF Debug
              THEN
              PutCon('Received Bad init   ',STDOUT);
             SendNAK(n);
           END;
       END;
   END;

  PROCEDURE DataToFile; (* output to file *)
  VAR
    len,i : integer;
    temp : string;
   BEGIN
     WITH Buf[CurrentPacket] DO
      BEGIN
        len := length(data);
        AddTo(ChInFile ,len);
        CASE EOLforFile OF
          LineFeed:     putstr(data,DiskFile);
          CrLf:
           BEGIN  (* don't output  CR *)
             FOR i:=1 TO len DO
             IF data[i] <> CR
              THEN
              putcf(data[i],DiskFile);
           END;
          JustCR:
           BEGIN   (* change CR to NEWLINE *)
             FOR i:=1 TO len DO
             IF data[i]=CR
              THEN
              data[i]:=NEWLINE;
             putstr(data,DiskFile);
           END;
         END;
        (* case *)
      END;
   END;

  PROCEDURE Dodata;  (* Process Data packet *)

   BEGIN
     WITH Buf[CurrentPacket] DO
      BEGIN
        IF  seq = ((n + 63) MOD 64)
         THEN
          BEGIN                (* data last one *)
            IF OldTry>MaxTry
             (* number of tries? *)
             THEN
              BEGIN
                State := Abort;
                PutErr('Old data - Too many ');
              END
             ELSE
              BEGIN
                SendACK(seq);
                NumTry := 0;
              END;
          END
         ELSE
          BEGIN            (* data - this one *)
            IF (n<>seq)
             THEN
             SendNAK(n)
             ELSE
              BEGIN
                SendACK(n); (* ACK *)
                DataToFile;
                OldTry := NumTry;
                NumTry := 0;
                n := (n+1) MOD 64;
              END;
          END;
      END;
   END;

  PROCEDURE DoFileLast;   (* Process File Packet *)
   BEGIN          (* File header - last one  *)
     IF OldTry > MaxTry (* tries ? *)
      THEN
       BEGIN
         State := Abort;
         PutErr('Old file - Too many ');
       END
      ELSE
       BEGIN
         OldTry := OldTry+1;
         WITH Buf[CurrentPacket] DO
          BEGIN
            IF seq = ((n + 63) MOD 64)
             (* packet number *)
             THEN
              BEGIN  (* send ACK *)
                SendACK(seq);
                NumTry := 0
              END
             ELSE
              BEGIN
                SendNAK(n);   (* NAK *)
              END;
          END;
       END;
   END;

  PROCEDURE DoEOF;  (* Process EOF packet *)
   BEGIN                 (* EOF - this one *)
     IF Buf[CurrentPacket].seq<>n    (* packet number ? *)
      THEN
      SendNAK(n) (* NAK *)
      ELSE
       BEGIN               (* send ACK *)
         SendACK(n);
         Sclose(DiskFile);  (* close file *)
         DiskFile := IOERROR;
         OldTry := NumTry;
         NumTry := 0;
         n := (n+1) MOD 64; (* next packet  *)
         State := FileHeader;   (* change state *)
       END;
   END;

  PROCEDURE ReceiveData;  (* Receive data packets *)
  VAR
    strend: integer;
    packetnum: string;
    good : boolean;

   BEGIN
     IF NumTry > MaxTry          (* check number of tries *)
      THEN
       BEGIN
         State := Abort;
         CtoS('Recv data -Too many ',packetnum);
         strend := itoc(n,packetnum,CONLENGTH+1);
         putstr(packetnum,STDOUT);
       END
      ELSE
       BEGIN
         NumTry := NumTry+1;                (* increase number of tries *)
         good := ReceivePacket;        (* get packet *)
         WITH Buf[CurrentPacket] DO
          BEGIN
            IF Verbosity
             THEN
              BEGIN
                PutCon('Receiving (Data)    ',STDOUT);
                PutNum(Buf[CurrentPacket].seq,STDOUT);
              END;
            IF ((ptype = TYPED) OR (ptype=TYPEZ)
                OR (ptype=TYPEF)) AND good           (* check type *)
             THEN
             CASE ptype OF
               TYPED:  DoData;
               TYPEF:  DoFileLast;
               TYPEZ:  DoEOF;
              END (* case *)
             ELSE
              BEGIN
                Verbose('Expected data pack  ');
                SendNAK(n);
              END;
          END;
       END;
   END;

  PROCEDURE DoBreak; (* Process Break packet *)
   BEGIN                    (* Break transmission *)
     IF Buf[CurrentPacket].seq<>n    (* packet number ? *)
      THEN
      SendNAK(n) (* NAK *)
      ELSE
       BEGIN            (* send  ACK *)
         SendACK(n) ;
         State := Complete  (* change state *)
       END
   END;

  PROCEDURE DoFile; (* Process file packet *)
   BEGIN                 (* File Header *)
     WITH Buf[CurrentPacket] DO
      BEGIN
        IF seq<>n           (* packet number ? *)
         THEN
         SendNAK(n)  (* NAK *)
         ELSE
          BEGIN               (* send ACK *)
            SendACK(n);
            AddTo(ChInFile, length(data));
            GetFile(data);   (* get file name *)
            OldTry := NumTry;
            NumTry := 0;
            n := (n+1) MOD 64; (* next packet  *)
            IF (State <> Abort) THEN State := FileData;   (* change state *)
          END;
      END;
   END;

  PROCEDURE DoEOFLast; (* Process EOF Packet *)
   BEGIN               (* End Of File Last One*)
     IF OldTry > MaxTry (* tries ? *)
      THEN
       BEGIN
         State := Abort;
         PutErr('Old EOF - Too many  ');
       END
      ELSE
       BEGIN
         OldTry := OldTry+1;
         WITH Buf[CurrentPacket] DO
          BEGIN
            IF seq =((n + 63 ) MOD 64)
             (* packet number *)
             THEN
              BEGIN  (* send ACK *)
                SendACK(seq);
                Numtry := 0
              END
             ELSE
              BEGIN
                SendNAK(n);  (* NAK *)
              END
          END;
       END;
   END;

  PROCEDURE DoInitLast;
   BEGIN                (* Init Packet - last one *)
     IF OldTry>MaxTry   (* number of tries? *)
      THEN
       BEGIN
         State := Abort;
         PutErr('Old init - Too many ');
       END
      ELSE
       BEGIN
         OldTry := OldTry+1;
         IF Buf[CurrentPacket].seq = ((n + 63) MOD  64)
          (* packet number *)
          THEN
           BEGIN   (* send ACK *)
             WITH Buf[ThisPacket] DO
              BEGIN
                count := NUMPARAM;
                seq := Buf[CurrentPacket].seq;
                ptype := TYPEY;
                EnCodeParm(data);
              END;
             SendPacket;
             NumACK := NumACK+1;
             NumTry := 0;
           END
          ELSE
           BEGIN
             SendNAK(n);  (* NAK *)
           END;
       END;
   END;

  PROCEDURE ReceiveFile; (* receive file packet *)
  VAR
    good: boolean;

   BEGIN
     IF NumTry > MaxTry          (* check number of tries *)
      THEN
       BEGIN
         State := Abort;
         PutErr('Recv file - Too many');
       END
      ELSE
       BEGIN
         NumTry := NumTry+1;                (* increase number of tries *)
         good := ReceivePacket;             (* get packet *)
         WITH Buf[CurrentPacket] DO
          BEGIN
             IF VERBOSITY THEN BEGIN
                PutCon('Receiving (File)    ',STDOUT);
        PutNum(seq,STDOUT);
             END;
                PutCon(' RECEIVING...       ',STDOUT);
                putstr(data,stdout);
            IF ((ptype = TYPES) OR (ptype=TYPEZ)
                OR (ptype=TYPEF) OR (ptype=TYPEB)) (* check type *)
             AND good
             THEN
             CASE ptype OF
               TYPES:  DoInitLast;
               TYPEZ:  DoEOFLast;
               TYPEF:  DoFile;
               TYPEB:  DoBreak;
              END (* case *)
             ELSE
              BEGIN
                IF Debug
                 THEN
                 PutCon('Expected File Pack  ',STDOUT);
                SendNAK(n);
              END;
          END;
       END;
   END;

  PROCEDURE RecvSwitch; (* this procedure is the main receive routine *)
   BEGIN
     State := Init;
     NumTry := 0;
     IF NOT Local THEN
       BEGIN
         TTYRAW;                 (* if host--put tty in raw mode *)
         TtyMode := Raw;
       END;
     StartRun;
      REPEAT
       CASE State OF
         FileData:       ReceiveData;
         Init:           ReceiveInit;
         Break:          (* nothing *);
         FileHeader:     ReceiveFile;
         EOFile:         (* nothing *);
         Complete:       (* nothing *);
         Abort:          (* nothing *);
        END;
       (* case *)
      UNTIL (State = Abort ) OR ( State = Complete );
     FLUSH;                     (* flush output buffer *)
     IF TtyMode = Raw THEN
       BEGIN
         TTYCOOKED;              (* if host--return tty to cooked mode *)
         TtyMode := Cooked;
       END;
   END;

 BEGIN
   SYSinit;             (*  system dependent  *)
   initio;
   done:=false;
   NumTry:=0;
   NumKeptErrors := 0;
   Pad := DEFPAD;               (* set defaults *)
   MyPad := DEFPAD;
   PadChar := DEFPADCHAR;
   MyPadChar := DEFPADCHAR;
   TheirTimeOut := DEFTIMEOUT;
   MyTimeOut := DEFTIMEOUT;
   Delay := DEFDELAY;
   SizeRecv := MAXPACK;
   SizeSend := MAXPACK;
   SendEOL := DEFEOL;
   MyEOL := DEFEOL;
   SendQuote := DEFQUOTE;
   MyQuote := DEFQUOTE;
   MaxTry := DEFTRY;
   Halfduplex := DEFDUPLEX;
   CASE DEFEOLTYPE OF
     1:      EOLforFile := LineFeed;
     2:      EOLforFile := CrLf;
     3:      EOLforFile := JustCR;
    END (* case *);
   CtoS(PFILE,ParmFile);
   GetParm;
   Local := false;      (* default to remote *)
   TtyMode := Cooked;


repeat
   initcmd;

     KermitInit;       (* initialize *)

     WHILE ( NextArg <= nargs ) AND (RUNTYPE<>transmit) and
        (RUNTYPE<>receive) and (RUNTYPE<>print) and (not done)
    DO
      BEGIN
        (* check for valid commands *)
        (* r s c M x u z *)
        IF
        (aline[1]=LETS) OR
        (aline[1]=LETR) OR
        (aline[1]=LETP) OR
        (aline[1]=LETC) OR
        (aline[1]=LETM) OR
        (aline[1]=LETX) OR
        (aline[1]=LETU) OR
        (aline[1]=LETZ) OR
        (aline[1]=LETH) OR
        (aline[1]=LETQ) OR
        (aline[1]=LETT) OR
        (aline[1]=LETE)
       THEN
         CASE aline[1] OF
           LETS:   RunType := Transmit;
           LETR:   RunType := Receive;
           LETP:   RunType := PRINT;
           LETE,LETQ:   done:=true;
           LETC:
            BEGIN               (* look for -lvd *)
              FOR j := length(aline) DOWNTO 1 DO
               BEGIN
                 IF (aline[j]=LETC)
                  THEN
                   BEGIN
                     Local := true;
                     IF NOT OneWayOnly
                      THEN
                       BEGIN
                        Local := connect(Halfduplex);
                        IF NOT Local THEN
                         PutErr('Cannot connect      ');
                       END;
                   END;
                 IF (aline[j]=LETV)
                  THEN
                  Verbosity := true;
                 IF (aline[j]=LETD)
                  THEN
                  Debug := true;
                 IF (aline[j]=LETH)
                  THEN
                  Halfduplex := true;
                 IF (aline[j]=LETF)
                  THEN
                  Halfduplex := false;
               END;
            END;
           LETH:   BEGIN WRITELN;
                         WRITELN('KERMIT-H Comands:');
                         WRITELN;
(*
WRITELN('C [H/F/D/V]               - Connect [Half/Full duplex,Debug,Verbose]');
*)
Writeln('S <filename> {<filename>} - Send files');
Writeln('R {<filename>}            - Receive files');
(*
Writeln('P {<filename>]            - Print files');
*)
Writeln('H                         - Help {this message}');
Writeln('E                         - Exit');
Writeln('Q                         - Quit');
                   END;
           LETX:   OneWayOnly := true;
           LETM:   SetParameters;
           LETU:   SYSarguments;   (* do special for SYSTEM *)
           LETZ:
            BEGIN
              IF (aline[2]=LETL) OR (aline[2]=LETC)
               OR (aline[2]=LETR)
               THEN
               CASE aline[2] OF
                 LETL:   EOLforFile := LineFeed;
                 LETC:   EOLforFile := CrLf;
                 LETR:   EOLforFile := JustCR;
                END (* case *);
            END;
           LETT:
            BEGIN
              FILECREATE(TRACEFILE);
              bind(filet,TRACEFILE,BindStatus);
              IF BindStatus = 0 THEN Trace := true;
              Verbosity := true;
              Debug := true;
              TtyMode := RAW;
              PutCon('Kermit Trace Output ',STDOUT);
              PutCon('                    ',STDOUT);
              TtyMode := COOKED;
            END;
          END (* case *)
         ELSE
         Usage;
         (* get next argument *)
        NextArg := NextArg+1;
        IF (NextArg <= nargs )
         THEN
         IF NOT getarg(NextArg,aline,MAXSTR)
          THEN
          Usage;
      END;

     CASE RunType OF
       Receive:
        BEGIN (* filename is optional here *)
          IF getarg(NextArg,aline,MAXSTR)
           THEN
            BEGIN
              IF Exists(aline)
               THEN
                BEGIN
                  PutErr('Overwriting         ');
                  putstr(aline,STDOUT);
                END;
              DiskFile := Sopen(aline,IOWRITE);
              IF DiskFile <= IOERROR
               THEN
               ErrorPack('Cannot Open File    ');
            END;
          RecvSwitch;
        END;

       PRINT:
        BEGIN
              CtoS(LP,aline);
              DiskFile := Sopen(aline,IOWRITE);
              IF DiskFile <= IOERROR
               THEN
               ErrorPack('Cannot Open File    ');
          RecvSwitch;
        END;

       Transmit:
        BEGIN (* must give filename *)
          FOR j:= NextArg TO nargs DO
           BEGIN
             IF NOT getarg(NextArg,aline,MAXSTR)
              THEN
              Usage;
             IF NOT Exists(aline)
              THEN
              ErrorPack('File not found      ');
           END;
          IF getarg(NextArg,aline,MAXSTR)
           THEN SendSwitch;
        END;
       Invalid:        (* nothing *);
       SetParm:        (* nothing *);
      END;
     (* case *)

until done;

     FinishUp; (* End of Program *)

     IF (NumKeptErrors > 0)     (* Print any message we couldn't before *)
      THEN
       BEGIN
         PutCon('   Delayed Messages:',STDOUT);
         FOR J := 1 TO NumKeptErrors DO PutCon(KeptErrors[J],STDOUT);
       END;

9999:
     SYSFINISH;  (* do System dependent *)
END.